perm filename TMP2[0,BGB] blob sn#112403 filedate 1974-07-19 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	INTEGER PROCEDURE MKFE(INTEGER V1,F,V2)
C00007 ENDMK
C⊗;
INTEGER PROCEDURE MKFE(INTEGER V1,F,V2);
BEGIN
	INTEGER V1,F,V2,FNEW,ENEW,E,E0,B,V;
COMMENT MKFE MANDALA
	        o--------o       o--------o
	        |   E2    \     /   E1    |
	        |   nccw   \   /   pcw    |
	        |           \ /		  |
	        |       pvt  ⊗  V1        |
	        |            |		  |
	        |     FNEW   ENEW    F    |
	        |            |		  |
	        |       nvt  ⊗  V2	  |
		|           / \		  |
	        |    ncw   /   \   pccw   |
	        |    E3   /     \    E4   |
	        o--------o       o--------o	;

	FNEW ← MKF(F);	ENEW ← MKE(PED(F));	COMMENT CREATE NEW FACE & EDGE;
	PED(F) ← PED(FNEW) ← ENEW;		COMMENT LINK THE NEW EDGE...;
	PFACE(ENEW) ← F; NFACE(ENEW) ← FNEW;	COMMENT ...TO ITS FACES;
	PVT(ENEW) ← V1; NVT(ENEW) ← V2;		COMMENT ...AND TO ITS VERTICES;

COMMENT GET THE UPPER WINGS OF THE NEW EDGE.
	E2 ← PED(V1);
	DO E2 ← ECW((E1 ← E2),V1) UNTIL FCW(E1,V1) = F;

COMMENT GET THE LOWER WINGS OF THE NEW EDGE.
	E2 ← PED(V1);
	DO E2 ← ECW((E1 ← E2),V1) UNTIL FCW(E1,V1) = F;

;GET THE LOWER WINGS.
	PED E,V2↔DAC E,E0↔DAC E,EDGE0#
L2:	LAC E0,E↔SETQ(E,{ECW,E0,V2})
	CALL(FCW,E0,V2)↔CAME 1,F↔GO[
	CAME E,EDGE0↔GO L2↔FATAL(MKFE - V2 HAS NO WINGS)]
L2A:	DAC E0,E3#↔DAC E,E4#

;CDR V2'S TAIL REPLACING F'S WITH FNEW.
	E ← E3;
	V ← V2
L3:	MOVS 1,1(E)↔CAME 1,1(E)↔GO L4
	PFACE. FNEW,E
	V ← OTHER(E,V);
	E ← ECCW(E,V);
GO L3

;CCW FROM V1 REPLACING F'S WITH FNEW.
L4:	LAC E0,E↔LAC E,E2↔SETZM A#↔CAMN E0,E2↔GO L6
L5:	TESTZ E,WASP↔JSR WASPS
	NFACE 0,E↔CAME F,0
	GO[PFACE. FNEW,E↔GO .+2]
	   NFACE. FNEW,E
	CAME E,E0
	GO[DAC E,A↔SETQ(E,{ECCW,E,FNEW})↔GO L5]

;LINK THE WINGS.
L6:	WING(E1,ENEW);
	WING(E2,ENEW);
	WING(E3,ENEW);
	WING(E4,ENEW);
	RETURN(ENEW);
END;